home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD Fun House 8
/
CD Funhouse Version 8.0 - Wayzata Technology (7013) (1993).iso
/
pc
/
pc
/
cards
/
v9n04
/
concen.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-10-20
|
3KB
|
107 lines
PROGRAM Concentration;
USES crt, cards;
TYPE
concen = OBJECT (game)
places : array[0..51] of CardP;
mrk, cur, removed, guesses : Word;
CONSTRUCTOR Init;
DESTRUCTOR Done; virtual;
PROCEDURE Play;
END;
CONSTRUCTOR concen.Init;
VAR N : Byte;
BEGIN
game.Init($1E);
D := New(DeckP, Init(0, 0, TableColor)); D^.shuffle;
TextAttr := TableColor;
ClrScr;
FOR N := 0 to 51 DO
BEGIN
places[N] := CardP(D^.FromTop);
places[N]^.PutInPlace(6*(N MOD 13)+1, 6*(N DIV 13)+1);
places[N]^.Display;
END;
mrk := 52; cur := 0; removed := 0; guesses := 0;
END;
DESTRUCTOR Concen.Done; BEGIN game.done; END;
PROCEDURE Concen.Play;
VAR
CH : Char;
PROCEDURE BkwdNonNIL;
BEGIN WHILE Places[cur] = NIL DO cur := (cur+51) MOD 52; END;
PROCEDURE FwrdNonNIL;
BEGIN WHILE Places[cur] = NIL DO cur := (cur+1) MOD 52; END;
PROCEDURE PressedEnter;
BEGIN
IF mrk = 52 THEN {nothing marked, flip it}
BEGIN
mrk := cur; Inc(Guesses);
WITH Places[mrk]^ DO BEGIN TurnUp; Display; END;
END
ELSE
BEGIN
IF mrk = cur THEN Beep
ELSE
BEGIN
Inc(Guesses);
WITH Places[cur]^ DO BEGIN TurnUp; Display; END;
IF Places[cur]^.GetRank = Places[mrk]^.GetRank THEN
BEGIN
Happy; Delay(1000);
Inc(removed, 2);
Places[cur]^.hide; Places[mrk]^.Hide;
dispose(Places[cur], done); Places[cur] := NIL;
dispose(Places[mrk], done); Places[mrk] := NIL;
mrk := 52;
IF removed < 52 THEN FwrdNonNIL;
END
ELSE
BEGIN
Sad; Delay(1000);
WITH Places[cur]^ DO BEGIN TurnDown; Display; END;
WITH Places[mrk]^ DO BEGIN TurnDown; Display; END;
mrk := 52;
END;
END;
END;
END;
BEGIN
REPEAT
Places[cur]^.PointT(dn);
CH := ReadKey;
Places[cur]^.UnPoin(dn);
CASE CH OF
#0 : CASE ReadKey OF
#$48 : BEGIN cur := (cur+39) MOD 52; BkwdNonNIL; END;
#$50 : BEGIN cur := (cur+13) MOD 52; FwrdNonNIL; END;
#$4B : BEGIN cur := (cur+51) MOD 52; BkwdNonNIL; END;
#$4D : BEGIN cur := (cur+ 1) MOD 52; FwrdNonNIL; END;
END;
#13 : PressedEnter;
#27 : ;
END;
UNTIL (removed = 52) OR (CH = #27);
GotoXY(1, 25);
TextAttr := $70;
IF CH = #27 THEN Write('You quit after ', guesses, ' guesses.')
ELSE
BEGIN
Happy; Happy; Happy;
Write('You WON! You used ', guesses, ' guesses.');
END;
END;
VAR cgame : concen;
BEGIN
cgame.Init;
cgame.Play;
END.